7.1 Erzeugung von Film- & Nutzerprofilen [20 Punkte]

library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.3     ✔ readr     2.1.4
## ✔ forcats   1.0.0     ✔ stringr   1.5.0
## ✔ ggplot2   3.4.3     ✔ tibble    3.2.1
## ✔ lubridate 1.9.3     ✔ tidyr     1.3.0
## ✔ purrr     1.0.2     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(recommenderlab)
## Loading required package: Matrix
## 
## Attaching package: 'Matrix'
## 
## The following objects are masked from 'package:tidyr':
## 
##     expand, pack, unpack
## 
## Loading required package: arules
## 
## Attaching package: 'arules'
## 
## The following object is masked from 'package:dplyr':
## 
##     recode
## 
## The following objects are masked from 'package:base':
## 
##     abbreviate, write
## 
## Loading required package: proxy
## 
## Attaching package: 'proxy'
## 
## The following object is masked from 'package:Matrix':
## 
##     as.matrix
## 
## The following objects are masked from 'package:stats':
## 
##     as.dist, dist
## 
## The following object is masked from 'package:base':
## 
##     as.matrix
## 
## Registered S3 methods overwritten by 'registry':
##   method               from 
##   print.registry_field proxy
##   print.registry_entry proxy

1. MovieLense Daten einlesen

data("MovieLense")

2. Binäre User-Liked-Items Matrix für alle Nutzer erzeugen,

UIB <- binarize(MovieLense, minRating = 4)

UIB <- as(UIB, "matrix")

UIB[1:5, 1:5]
##   Toy Story (1995) GoldenEye (1995) Four Rooms (1995) Get Shorty (1995)
## 1             TRUE            FALSE              TRUE             FALSE
## 2             TRUE            FALSE             FALSE             FALSE
## 3            FALSE            FALSE             FALSE             FALSE
## 4            FALSE            FALSE             FALSE             FALSE
## 5             TRUE            FALSE             FALSE             FALSE
##   Copycat (1995)
## 1          FALSE
## 2          FALSE
## 3          FALSE
## 4          FALSE
## 5          FALSE

In der UIB (User Item Binär) Matrix sind Ratings kleiner als 4 mit False und sonst als True kodiert.

3. Dimension der User-Liked-Items Matrix prüfen und ausgeben

dim(UIB)
## [1]  943 1664

Die Matrix UIB hat 943 User und 1664 Filme.

4. Movie-Genre Matrix für alle Filme erzeugen

movieGenreDf <- MovieLenseMeta %>% select(-c(year, url))
rownames(movieGenreDf) <- movieGenreDf[,1]
movieGenreDf <- movieGenreDf %>% select(-c(title))
MGM <- as.matrix(movieGenreDf)
MGM[1:3, 1:3]
##                   unknown Action Adventure
## Toy Story (1995)        0      0         0
## GoldenEye (1995)        0      1         1
## Four Rooms (1995)       0      0         0

Wir sehen die ersten drei Zeilen (Filme) und die ersten drei Spalten (Genres) mit Unknown, Action und Adventure. Falls das Genre zustimmt für den Film, steht eine 1 sonst 0.

5. Dimension der Movie-Genre Matrix prüfen und ausgeben,

dim(MGM)
## [1] 1664   19

MGM (Movie Genre Matrix) hat 1664 Zeilen als Filme und 19 Spalten als Genres.

6. Anzahl unterschiedlicher Filmprofile bestimmen und visualisieren

getMovieGenreMatrix <- function(movieLenseMeta) {
  movieGenreDf <- movieLenseMeta %>% select(-c(year, url))
  rownames(movieGenreDf) <- movieGenreDf[, 1]
  movieGenreDf <- movieGenreDf %>% select(-c(title))
  MGM <- as.matrix(movieGenreDf)
  return(MGM)
}

MGM <- getMovieGenreMatrix(MovieLenseMeta)

genreColNames <- colnames(MGM)

for (colName in genreColNames) {
  MGM[, colName] <- ifelse(MGM[, colName] == 1, colName, NA)
}

MGMdf <- as.data.frame(MGM)

# Concatenate row-wise with a separator
MGMdfConcat <- MGMdf %>%
  unite("profile", sep = ".", na.rm = TRUE, remove = TRUE)

# Group by profile, count the occurrences and arrange in descending order
genreCounts <- MGMdfConcat %>%
  group_by(profile) %>%
  summarise(Anzahl = n()) %>%
  arrange(desc(Anzahl))

# Select the top 20 profiles by count and arrange them by count
top20Genres <- genreCounts %>%
  head(20) %>%
  arrange(Anzahl)

# Create a bar plot
ggplot(top20Genres, aes(x = Anzahl, y = profile, fill = "blue")) +
  geom_bar(stat = "identity") + 
  labs(title = "Genre Combinations and Occurencies (MovieProfiles)", 
       x = "Occurencies", 
       y = "Genre",
       subtitle = "MovieLens Dataset") +
  theme(legend.position = "none")

Wir sehen im Plot die Kombination diverser Genres und deren Häufigkeit. Drama taucht am häufigsten auf, gefolgt von Comedy.

7. Nutzerprofile im Genre-Vektorraum erzeugen

MGM <- getMovieGenreMatrix(MovieLenseMeta)
UIB <- as.matrix(UIB)
MGM <- as.matrix(MGM)

# If the matrices contain non-numeric data
UIB <- apply(UIB, 2, as.numeric)
MGM <- apply(MGM, 2, as.numeric)

# matrix multiplication
# UGM = User Genre Matrix
UGM <- UIB %*% MGM

# UGPdf = User Genre Profile Data Frame
UGPdf <- as.data.frame(UGM)
head(UGPdf)

Wir sehen die Nutzerprofile, d.h. zu jeder Nutzerin wie häufig ihr ein Genre gefallen hat, basierend auf ihren Ratings (Binäre User-Liked-Items Matrix).

8. Dimension der User-Genre-Profil Matrix prüfen und ausgeben,

dim(UGPdf)
## [1] 943  19

943 Nutzerinnen und 19 Genres.

9. Anzahl unterschiedlicher Nutzerprofile bestimmen, wenn Stärke der Genre-Kombination (a) vollständig (b) binär berücksichtigt wird.

# (a) vollständig
print(paste("Unterschiedliche Nutzerprofile vollständig:", nrow(unique(UGPdf))))
## [1] "Unterschiedliche Nutzerprofile vollständig: 943"
# (b) binär
UPB <- UGPdf > (2 * rowMeans(UGPdf))
print(paste("Unterschiedliche Nutzerprofile Binär:", nrow(unique(UPB))))
## [1] "Unterschiedliche Nutzerprofile Binär: 137"

Eine nicht-binäre User-Profil-Matrix hat nur unterschiedliche Nutzerprofile. Eine binäre User Profile Matrix hat in diesem Fall 137 unterschiedliche Nutzerprofile.

7.2 Ähnlichkeit von Nutzern und Filmen [10 Punkte]

1. Cosinus-Ähnlichkeit zwischen User-Genre- und Movie-Genre-Matrix berechnen.

getCosineSim <- function(M, A) {
  MA_T <- M %*% t(A)
  l2NormM <- sqrt(rowSums(M^2))
  l2NormA <- sqrt(rowSums(A^2))
  l2Norm <- l2NormM %*% t(l2NormA)
  return(MA_T / l2Norm)
}
cosine_UGM_MGM <- getCosineSim(UGM, MGM)

Die folgende Funktion berechnet die Kosinus Ähnlichkeit zwischen zwei Matrizen, in diesem Fall zwischen der User-Genre-Matrix und Movie-Genre-Matrix.

2. Dimension der Matrix der Cosinus-Ähnlichkeiten von Nutzern und Filmen prüfen uns ausgeben.

dim(cosine_UGM_MGM)
## [1]  943 1664

Die Ähnlichkeitsmatrix hat 943 Zeilen (Nutzerinnen) und 1664 Spalten (Filme)

3. 5-Zahlen Statistik für Matrix der Cosinus-Ähnlichkeiten prüfen uns ausgeben.

v <- as.vector(cosine_UGM_MGM)
summary(v)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
##  0.0000  0.2300  0.4070  0.4098  0.5919  0.9768    1664

Wir können prüfen ob die Ähnlichkeitsmatrix korrekt berechnet wurden, indem das Intervall von Min. und Max. zwischen [0, 1] liegt, was hier der Fall ist.

4. Cosinus-Ähnlichkeiten von Nutzern und Filmen mit Dichteplot visualisieren.

density <- data.frame(x = as.vector(cosine_UGM_MGM))
ggplot(density, aes(x)) +
  geom_density() +
  labs(title = "Density Plot of Cosine Similarity between Users and Movies", x = "Cosine Similarity", y = "Density") +
  theme_minimal()
## Warning: Removed 1664 rows containing non-finite values (`stat_density()`).

Im Dichteplot sehen wir sehr viele Werte nahe bei Null. Die meisten Werte befinden sich aber im Intervall [0.25, 0.75].

5. Cosinus-Ähnlichkeiten von Nutzern und Filmen mit Dichteplot für Nutzer “241”, “414”, “477”, “526”, “640” und “710” visualisieren.

ggplot() +
  geom_density(aes(cosine_UGM_MGM[, 241], color = "Genre 1"), fill = "yellow", alpha = 0.05) +
  geom_density(aes(cosine_UGM_MGM[, 414], color = "Genre 2"), fill = "green", alpha = 0.05) +
  geom_density(aes(cosine_UGM_MGM[, 477], color = "Genre 3"), fill = "blue", alpha = 0.05) +
  geom_density(aes(cosine_UGM_MGM[, 526], color = "Genre 4"), fill = "orange", alpha = 0.05) +
  #geom_density(aes(cosine_UGM_MGM[, 640], color = "Genre 5"), fill = "black", alpha = 0.05) +
  geom_density(aes(cosine_UGM_MGM[, 710], color = "Genre 6"), fill = "purple", alpha = 0.05) +
  labs(
    title = "Density Plot of Cosine Similarity between Users and Genres",
    x = "Cosine Similarity",
    y = "Density"
  ) +
  scale_color_manual(
    name = "Genres",
    values = c("Genre 1" = "yellow", "Genre 2" = "green", "Genre 3" = "blue", 
               "Genre 4" = "orange", "Genre 6" = "purple")
  ) +
  theme_minimal()
## Warning: Removed 1 rows containing non-finite values (`stat_density()`).
## Removed 1 rows containing non-finite values (`stat_density()`).
## Removed 1 rows containing non-finite values (`stat_density()`).
## Removed 1 rows containing non-finite values (`stat_density()`).
## Removed 1 rows containing non-finite values (`stat_density()`).

ggplot() +
  geom_density(aes(cosine_UGM_MGM[, 241], color = "Genre 1"), fill = "yellow", alpha = 0.05) +
  geom_density(aes(cosine_UGM_MGM[, 414], color = "Genre 2"), fill = "green", alpha = 0.05) +
  geom_density(aes(cosine_UGM_MGM[, 477], color = "Genre 3"), fill = "blue", alpha = 0.05) +
  geom_density(aes(cosine_UGM_MGM[, 526], color = "Genre 4"), fill = "orange", alpha = 0.05) +
  geom_density(aes(cosine_UGM_MGM[, 640], color = "Genre 5"), fill = "black", alpha = 0.05) +
  geom_density(aes(cosine_UGM_MGM[, 710], color = "Genre 6"), fill = "purple", alpha = 0.05) +
  labs(
    title = "Density Plot of Cosine Similarity between Users and Genres",
    x = "Cosine Similarity",
    y = "Density"
  ) +
  scale_color_manual(
    name = "Genres",
    values = c("Genre 1" = "yellow", "Genre 2" = "green", "Genre 3" = "blue", 
               "Genre 4" = "orange", "Genre 5" = "black", "Genre 6" = "purple")
  ) +
  theme_minimal()
## Warning: Removed 1 rows containing non-finite values (`stat_density()`).
## Removed 1 rows containing non-finite values (`stat_density()`).
## Removed 1 rows containing non-finite values (`stat_density()`).
## Removed 1 rows containing non-finite values (`stat_density()`).
## Removed 1 rows containing non-finite values (`stat_density()`).
## Removed 1 rows containing non-finite values (`stat_density()`).

Wir sehen für Genre 5 einen starken Anstieg nahe 0, d.h. viele Nutzerinnen haben keine Ähnlichkeit mit diesem Genre. Wir müssen Genre 5 aus der Visualisierung entfernen, weil wir sonst die restliche nicht miteinander vergleichen können. Genre 4 hat weniger Ähnlichkeit mit den Nutzerinnen, und liegt mehr im Bereich von 0.25. Genre 1, 2 und 3 scheinen Ähnlichkeiten mit den Nutzerinnen zu teilen. Genre 6 ist den Nutzerinnen am ähnlichsten.

7.3 Empfehlbare Filme [6 Punkte]

1. Bewertete Filme maskieren, d.h. “Negativabzug” der User-Items Matrix erzeugen, um anschliessend Empfehlungen herzuleiten.

URM <- as(MovieLense, "matrix")
URMmasked <- is.na(URM)
URMmasked[1:4, 1:4]
##   Toy Story (1995) GoldenEye (1995) Four Rooms (1995) Get Shorty (1995)
## 1            FALSE            FALSE             FALSE             FALSE
## 2            FALSE             TRUE              TRUE              TRUE
## 3             TRUE             TRUE              TRUE              TRUE
## 4             TRUE             TRUE              TRUE              TRUE

Um den Negativabzug der User-Item Matrix zu erzeugen, werden fehlende Werte mit der Funktion is.na() auf True und sonst False gesetzt.

2. Zeilensumme des “Negativabzuges” der User-Items Matrix für die User “5”, “25”, “50” und “150” ausgeben.

userSums <- rowSums(URMmasked)[c(5, 25, 50, 150)]
relative <- userSums / ncol(URM)
userSums
##    5   25   50  150 
## 1489 1586 1641 1633
relative
##         5        25        50       150 
## 0.8948317 0.9531250 0.9861779 0.9813702

Alle vier User haben mehr als 1000 Filme bewertet. Damit liegen sie im Bereich von 90% und höher, im Bezug auf fehlende Bewertungen.

3. 5-Zahlen Statistik der Zeilensumme des “Negativabzuges” der User-Items Matrix bestimmen.

summary(rowSums(URMmasked))
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##     929    1516    1600    1559    1632    1645

Es gibt eine oder mehrere Nutzerinnen die noch 929 Filme von 1664 nicht bewertet haben. Im Durchschnitt haben die Nutzerinnen 1559 Filme nicht bewertet. 25% von allen Nutzerinnen haben 1516 Filme nicht bewertet und 75% von allen Nutzerinnen haben 1632 Filme nicht bewertet.

7.4 Top-N Empfehlungen [12 Punkte]

1. Matrix für Bewertung aller Filme durch element-weise Multiplikation der Matrix der CosinusÄhnlichkeiten von Nutzern und Filmen und “Negativabzug” der User-Items Matrix erzeugen.

URM_CS <- URMmasked * cosine_UGM_MGM
URM_CS[1:3, 1:4]
##   Toy Story (1995) GoldenEye (1995) Four Rooms (1995) Get Shorty (1995)
## 1        0.0000000        0.0000000         0.0000000         0.0000000
## 2        0.0000000        0.3004993         0.1951800         0.7700294
## 3        0.1549193        0.4647580         0.3577709         0.6713171

Die maskierte User Rating Matrix mit der Cosinus Ähnlichkeitsmatrix zwischen User-Genre und Movie-Genre erzeugt eine neue Matrix die 0 aufweist, falls die Filme vom User schon bewertet wurden. Werte ungleich Null sind Ähnlichkeiten zwischen Nutzerinnen und Filmen.

2. Dimension der Matrix für die Bewertung aller Filme prüfen.

dim(URM_CS)
## [1]  943 1664

Die Dimensionen sind gleichbleibend.

3. Top-20 Listen extrahieren und Länge der Listen pro Nutzer prüfen.

getTopNList <- function(n, R) {
  topN <- matrix(0, dim(R), n)
  for (userId in rownames(R)) {
    topN[as.numeric(userId), ] <- names(sort(R[userId, ], decreasing = TRUE)[1:n])
  }
  return(topN)
}

top20 <- getTopNList(20, URM_CS)
top20[1:5, 1:5]
##      [,1]                         [,2]                    
## [1,] "House of Yes, The (1997)"   "Best Men (1997)"       
## [2,] "Cinema Paradiso (1988)"     "Wings of Desire (1987)"
## [3,] "Wild Things (1998)"         "Diva (1981)"           
## [4,] "From Dusk Till Dawn (1996)" "Diva (1981)"           
## [5,] "Army of Darkness (1993)"    "Money Talks (1997)"    
##      [,3]                     [,4]                            
## [1,] "Wings of Desire (1987)" "Manhattan (1979)"              
## [2,] "Manhattan (1979)"       "American President, The (1995)"
## [3,] "Client, The (1994)"     "2001: A Space Odyssey (1968)"  
## [4,] "Apollo 13 (1995)"       "Outbreak (1995)"               
## [5,] "I Love Trouble (1994)"  "Low Down Dirty Shame, A (1994)"
##      [,5]                                            
## [1,] "American President, The (1995)"                
## [2,] "Corrina, Corrina (1994)"                       
## [3,] "Midnight in the Garden of Good and Evil (1997)"
## [4,] "Terminator 2: Judgment Day (1991)"             
## [5,] "Cowboy Way, The (1994)"

Die Funktion liefert die Top-N Liste für den jeweiligen User basierend auf der Ähnlichkeits-Matrix aus der vorangegangen Aufgabe.

4. Verteilung der minimalen Ähnlichkeit für Top-N Listen für N = 10, 20, 50, 100 für alle Nutzer visuell vergleichen.

getTopNListSim <- function(n, R) {
  topN <- matrix(0, dim(R), n)
  for (userId in rownames(R)) {
    topN[as.numeric(userId), ] <- sort(R[userId, ], decreasing = TRUE)[1:n]
  }
  return(topN)
}

simN10 <- tibble(x = getTopNListSim(10, URM_CS)[, 10])
simN50 <- tibble(x = getTopNListSim(50, URM_CS)[, 50])
simN100 <- tibble(x = getTopNListSim(100, URM_CS)[, 100])

Die Funktion liefert die Top-N Liste als Ähnlichkeitswerte. Wir gehen davon aus, dass je mehr Filme empfohlen werden, desto weniger ähnlich sind sie zu der Nutzerin.

ggplot(simN10, aes(x)) +
  geom_histogram(binwidth = 0.005, na.rm = TRUE) +
  xlim(0, 1) +
  ylim(0, 35) +
  labs(title = "Similarity Distribution of Top 10 Recommendations of all Users", x = "Similarity", y = "Occurencies") +
  theme_minimal()

Für die top 10 Produkte liegen die meisten Ähnlichkeiten zwischen 0.70 und 0.9.

ggplot(simN50, aes(x)) +
  geom_histogram(binwidth = 0.005, na.rm = TRUE) +
  xlim(0, 1) +
  ylim(0, 35) +
  labs(title = "Similarity Distribution of Top 50 Recommendations of all Users", x = "Similarity", y = "Occurencies") +
  theme_minimal()

Wir sehen bei 50 schon einen guten Versatz der Verteilung Richtung links (weniger ähnlich).

ggplot(simN100, aes(x)) +
  geom_histogram(binwidth = 0.005, na.rm = TRUE) +
  xlim(0, 1) +
  ylim(0, 35) +
  labs(title = "Similarity Distribution of Top 100 Recommendations of all Users", x = "Similarity", y = "Occurencies") +
  theme_minimal()

Vergleichen wir die Top 10 und die Top 100, sehen wir den Unterschied ganz klar. Je mehr wir empfehlen, desto kleiner ist der Ähnlichkeitswert zwischen der Nutzerin und dem Film.

5. Top-20 Empfehlungen für Nutzer “5”, “25”, “50”, “150” visualisieren.

# some bug, had to refactor topNList function
getTopNList <- function(N, URM) {
  topNList <- list()
  nUser <- dim(URM)[1]
  nMovies <- dim(URM)[2]
  for (user in 1:nUser) {
    topNList[[user]] <- sort(URM[user, ], decreasing=TRUE)[1:N]
  }
  return(topNList)
}

plotCleveland <- function(URM, N, user) {
  topNList <- getTopNList(N, URM)
  topNUser <- topNList[[user]]
  simUser <- as.numeric(topNUser)
  movies <- names(topNUser)
  topNdf <- data.frame(movies, simUser)
  ggplot(topNdf, aes(x = simUser, y = movies)) + 
    geom_point() + 
    labs(title = paste("Top", N, "Recommendations for User", user), 
       x = "Similarity", 
       y = "Movie",
       subtitle = "MovieLense Dataset")
}

for (user in c(5, 25, 50, 150)) {
  print(plotCleveland(URM_CS, 20, user))
}

Im Cleveland Plot mit den den Top 20 Film Empfehlungen und den Ähnlichkeiten sehen wir für die User folgendes: User 5: Hat eine ausgeglichene Auswahl bekommen mit hohen Werten zwischen 0.7 und 0.8. User 25: Sieht man schon ein Cluster im Bereich von 0.65, entweder hat dieser nur wenige Filme bewertet oder ähnliche Filme bewertet. User 50: Sieht man klar das dieser nur das vorgeschlagen bekommt, was er schon gesehen/bewertet hat, weil er vielleicht nur wenige Bewertungen gegeben hat. Die diversity in dieser Empfehlung ist schlecht. Content-based Modelle tendieren dazu, nur vorzuschlagen was von der Nutzerin gemocht wurde. User 150: Sieht man ein Cluster im höheren Ende der Ähnlichkeitsskala, mit einer gewissen Varianz, diese Liste scheint eine gute Balance zu finden.

6. Für Nutzer “133” und “555” Profil mit Top-N Empfehlungen für N = 20, 30, 40, 50 analysieren, visualisieren und diskutieren.

Ns <- c(20,30,40,50)
users <- c(133, 555)
rowSums(URMmasked[users,])
##  133  555 
## 1638 1612
for (n in Ns) {
  for (user in users) {
    print(plotCleveland(URM_CS, n, user))
  }
}

Der Content-Based Recommender schlägt für die Nutzerin 133 sehr eintönige Bewertungen vor, dies kann daran liegen das diese wenige oder immer die gleiche Art von Genres bewertet hat. Nutzerin 133 hat auch weniger Bewertungen abgegeben 1664-1638 = 26, im Vergleich zu User 555, 1664 - 1612 = 52. Der Recommender schlägt bei der Nutzerin 555 schon eine grössere Varianz vor. Man sieht auch für grössere N, dass die Werte sich den User Profilen nähern.